﻿
Friend Class CodeEditor : Inherits ListBox

    Private CaretX As Integer = 0
    Private CaretY As Integer = 0
    Private KeyWordDict As FT8BinaryDictionary
    Private ClassDict As FT8BinaryDictionary
    Public Property ImportedDLL() As String()
    Private MetaData As MetaData


    Public Sub New()
        MyBase.new()
        Me.Lines.AddRange(New String() {"", ""})
        Me.Font = New Font("Courier New", 10, FontStyle.Bold)
        Me.SelectionMode = Windows.Forms.SelectionMode.One
        Me.SelectedIndex = 0
        Me.DrawMode = DrawMode.OwnerDrawFixed
        Me.ItemHeight = 16
        Me.DoubleBuffered = True
        Me.HorizontalExtent = 2000
        Me.HorizontalScrollbar = True

        Me.KeyWordDict = New FT8BinaryDictionary
        Me.ClassDict = New FT8BinaryDictionary
        For Each Word As String In KeyWords.Statements
            KeyWordDict.Add(Word.ToLower)
        Next
    End Sub

    Public Sub PerformImports()

        Me.MetaData = New MetaData
        For Each Path As String In ImportedDLL
            MetaData.AddReference(Path)
        Next
        Dim Types() As String = MetaData.GetValidType
        ClassDict = New FT8BinaryDictionary

        For Each T As String In Types
            If T.Trim <> "" Then
                ClassDict.Add(T.ToLower)
            End If
        Next

    End Sub


    Public ReadOnly Property Lines As ListBox.ObjectCollection
        Get
            Return MyBase.Items
        End Get
    End Property

    Public Overrides Property Text As String
        Get
            'TODO ==================
            Return "ToDo"
        End Get
        Set(ByVal value As String)
            Dim CodeLines() As String = value.Split(New String() {vbCrLf}, StringSplitOptions.None)
            Me.Lines.AddRange(CodeLines)
        End Set
    End Property





    Private Sub CodeEditor_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.GotFocus
        NativeMethods.CreateCaret(Me.Handle, CType(0, IntPtr), 1, Me.ItemHeight)
        NativeMethods.SetCaretPos(CaretX, CaretY)
        NativeMethods.ShowCaret(Me.Handle)
    End Sub

    Private Sub CodeEditor_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LostFocus
        NativeMethods.DestroyCaret()
    End Sub

    Private Sub CodeEditor_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp

        CaretY = (e.Location.Y \ Me.ItemHeight) * Me.ItemHeight '< - align to a multiple of height

        'When draging up pass the begining of the text

        '????????????? if caret is pass the end of the text
        'How do I know that i am at the end of the text if the
        'text is larger then the height of the control?????

        If CaretY > (Me.Lines.Count - 1) * Me.ItemHeight Then
            CaretY = (Me.Lines.Count - 1) * Me.ItemHeight
            Me.SelectedIndex = Me.Lines.Count - 1
        End If
        'To readjust if auto scroll up
        If CaretY \ Me.ItemHeight = Me.TotalVisibleItem Then
            CaretY -= Me.ItemHeight
        End If

        CaretX = Math.Min((e.Location.X \ 8) * 8, CStr(Me.SelectedItem).Length * 8)
        NativeMethods.SetCaretPos(CaretX, CaretY)
        Me.Refresh() '< ------- very not what we want -- Why do we get a caret artefact

    End Sub

    Private Sub CodeEditor_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown

        If (e.KeyCode >= Keys.A And e.KeyCode <= Keys.Z) Then 'Just a short cut for the most commun keys
            Exit Sub
        Else
            Select Case e.KeyCode

                Case Keys.Enter '' ----------------No bug found
                    Me.Lines.Insert(Me.SelectedIndex + 1, "")
                    Dim Temp As String = CStr(Me.Lines(Me.SelectedIndex))
                    Me.Lines(Me.SelectedIndex) = Temp.Substring(0, CaretX \ 8)
                    Me.SelectedIndex += 1
                    Me.Lines(Me.SelectedIndex) = Temp.Substring(CaretX \ 8)
                    CaretY += Me.ItemHeight
                    CaretX = 0
                    NativeMethods.SetCaretPos(CaretX, CaretY)
                    e.SuppressKeyPress = True

                    '=================================
                    'When I go left, the control dont scroll up when i get to the upper left corner

                Case Keys.Left
                    Dim swap As Boolean = False
                    CaretX -= 8
                    If CaretX < 0 Then
                        swap = True
                        CaretY -= Me.ItemHeight
                        If CaretY >= 0 Then
                            Me.SelectedIndex -= 1
                            CaretX = CStr(Me.SelectedItem).Length * 8
                        Else
                            CaretX = 0
                            CaretY = 0
                        End If
                    End If
                    NativeMethods.SetCaretPos(CaretX, CaretY)
                    If swap Then
                        Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight, (CaretY \ Me.ItemHeight) + 1})
                    Else
                        Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight})
                    End If
                    e.SuppressKeyPress = True

                    '======================================
                    'Mic Mac on the last line on bottom of control 
                    ' Caused by auto scroll

                Case Keys.Right
                    Dim swap As Boolean = False
                    CaretX += 8
                    If CaretX > CStr(Me.SelectedItem).Length * 8 Then
                        swap = True
                        CaretX = 0
                        CaretY += Me.ItemHeight
                        If Me.SelectedIndex < Me.Lines.Count - 1 Then
                            Me.SelectedIndex += 1
                        Else
                            CaretX = CStr(Me.SelectedItem).Length * 8
                            CaretY -= Me.ItemHeight
                        End If
                    End If

                    NativeMethods.SetCaretPos(CaretX, CaretY)
                    If swap Then
                        Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight, (CaretY \ Me.ItemHeight) - 1})
                    Else
                        Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight})
                    End If
                    e.SuppressKeyPress = True

                    '=================================
                    'Look OK

                Case Keys.Up ' ----------------No bug found
                    If Me.SelectedIndex > 0 Then
                        Me.SelectedIndex -= 1
                        CaretY -= Me.ItemHeight
                        If CaretX > CStr(Me.SelectedItem).Length * 8 Then
                            CaretX = CStr(Me.SelectedItem).Length * 8
                        End If
                        If CaretY < 0 Then CaretY = 0
                        NativeMethods.SetCaretPos(CaretX, CaretY)
                        Me.ShortRefresh(New Integer() {(CaretY \ Me.ItemHeight) + 1})
                    End If
                    e.SuppressKeyPress = True

                    '=================================
                    'When I go down, when the control scroll, the caret becomes invisible
                    'And short refresh the wrong line

                Case Keys.Down '--------------------- bug? = keep on going down after the text end??
                    If Me.SelectedIndex < Me.Lines.Count - 1 Then
                        Me.SelectedIndex += 1
                        CaretY += Me.ItemHeight
                        If CaretX > CStr(Me.SelectedItem).Length * 8 Then
                            CaretX = CStr(Me.SelectedItem).Length * 8
                        End If
                        NativeMethods.SetCaretPos(CaretX, CaretY)
                        Me.ShortRefresh(New Integer() {(CaretY \ Me.ItemHeight) - 1})
                    End If
                    e.SuppressKeyPress = True

                Case Keys.Back '-==================== bug = Dont wrap
                    If CaretX > 0 Then
                        CaretX -= 8
                        If CaretX = 0 Then
                            Me.Lines.Item(Me.SelectedIndex) = CStr(Me.SelectedItem).Substring(1)
                        Else
                            Dim First As String = CStr(Me.SelectedItem).Substring(0, CaretX \ 8)
                            Dim Second As String = CStr(Me.SelectedItem).Substring(CaretX \ 8 + 1)
                            Me.Lines.Item(Me.SelectedIndex) = First & Second
                        End If
                        NativeMethods.SetCaretPos(CaretX, CaretY)
                        Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight})
                    Else

                    End If
                    e.SuppressKeyPress = True

                Case Keys.Delete
                    'TODO ===============
                    e.SuppressKeyPress = True

                Case Keys.Home ' ----------------No bug found
                    CaretX = 0
                    NativeMethods.SetCaretPos(CaretX, CaretY)
                    Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight})
                    e.SuppressKeyPress = True

                Case Keys.End ' ----------------No bug found
                    CaretX = CStr(Me.SelectedItem).Length * 8
                    NativeMethods.SetCaretPos(CaretX, CaretY)
                    Dim sw As New Stopwatch
                    sw.Start()
                    Me.ShortRefresh(New Integer() {CaretY \ Me.ItemHeight})
                    sw.Stop()
                    Stop
                    e.SuppressKeyPress = True

                Case Keys.Tab
                    'TODO ===============
                    e.SuppressKeyPress = True

                Case Keys.PageUp
                    'TODO ===============
                    e.SuppressKeyPress = True

                Case Keys.PageDown
                    'TODO ===============
                    e.SuppressKeyPress = True

                Case Keys.Insert
                    'TODO ===============
                    e.SuppressKeyPress = True

            End Select

        End If

    End Sub

    Private Sub CodeEditor_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress

        LinesToRefresh = New Integer() {CaretY \ Me.ItemHeight}
        'To readjust if it auto scroll down
        If CaretY = 0 And Not TopVisibleItem = 0 Then
            CaretY += Me.ItemHeight
        End If

        IsShortRefresh = True
        Dim XIndex As Integer = CaretX \ 8
        Dim Li As String = CStr(Me.Lines.Item(Me.SelectedIndex))
        Li = Li.Insert(XIndex, e.KeyChar)
        Me.Lines.Item(Me.SelectedIndex) = Li
        CaretX += 8

        NativeMethods.SetCaretPos(CaretX, CaretY)
        e.Handled = True
    End Sub

#Region "Drawing"

    Private Sub listBox1_DrawItem(ByVal Sender As Object, ByVal e As DrawItemEventArgs) Handles Me.DrawItem

        If (e.Index < 0) Then Return
        If ((e.State And DrawItemState.Selected) = DrawItemState.Selected) Then

            e = New DrawItemEventArgs(e.Graphics,
                                      e.Font,
                                      e.Bounds,
                                      e.Index,
                                      e.State Xor DrawItemState.Selected,
                                      e.ForeColor,
                                      Color.WhiteSmoke)

        End If
        e.DrawBackground()
        Dim Idom() As Char = {"("c, ")"c, "."c, ","c, "{"c, "}"c, "["c, "]"c}
        Dim ThisLine As String = MyBase.Items(e.Index).ToString()
        Dim Ptr As Integer = 0
        Dim rec As Rectangle

        If ThisLine <> "" Then
            Dim Split() As String = SpecialSplit(ThisLine)
            For Each Token As String In Split

                If Token = "" Then
                    Continue For
                End If

                If Token.First = " "c Then
                    Ptr += Token.Length
                    Continue For
                End If

                If Token.First = """"c Then
                    rec = New Rectangle(Ptr * 8, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
                    ' e.Graphics.FillRectangle(Brushes.White, rec)
                    e.Graphics.DrawString(Token, e.Font, Brushes.Red, rec, StringFormat.GenericTypographic)
                    Ptr += Token.Length
                    Continue For
                End If

                If Token.First = "'"c Then
                    rec = New Rectangle(Ptr * 8, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
                    ' e.Graphics.FillRectangle(Brushes.White, rec)
                    e.Graphics.DrawString(Token, e.Font, Brushes.Green, rec, StringFormat.GenericTypographic)
                    Exit For
                End If
                If KeyWordDict.Contains(Token.ToLower) Then
                    rec = New Rectangle(Ptr * 8, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
                    ' e.Graphics.FillRectangle(Brushes.White, rec)
                    e.Graphics.DrawString(Token, e.Font, Brushes.Blue, rec, StringFormat.GenericTypographic)
                    Ptr += Token.Length
                Else
                    If ClassDict.Contains(Token.ToLower) Then
                        rec = New Rectangle(Ptr * 8, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
                        ' e.Graphics.FillRectangle(Brushes.White, rec)
                        e.Graphics.DrawString(Token, e.Font, Brushes.DarkTurquoise, rec, StringFormat.GenericTypographic)
                        Ptr += Token.Length
                    Else

                        rec = New Rectangle(Ptr * 8, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
                        ' e.Graphics.FillRectangle(Brushes.White, rec)
                        e.Graphics.DrawString(Token, e.Font, Brushes.Black, rec, StringFormat.GenericTypographic)
                        Ptr += Token.Length
                    End If

                End If

            Next
        End If

        'e.DrawFocusRectangle()
    End Sub

    'Monitor if the empty string are worth the trouble of removing them
    Private Function SpecialSplit(ByVal Input As String) As String()
        Dim Separator() As Char = {" "c, "("c, ")"c, "."c, """"c, "'"c, ","c, "{"c, "}"c, "["c, "]"c}
        Dim Broken() As Char = Input.ToCharArray
        Dim TempList As New List(Of Char)()
        Dim WordList As New List(Of String)
        Dim IsIn As Boolean = False
        If Input.Trim = "" Then
            Return New String() {""}
        End If
        'The Ident
        Dim i As Integer = 0
        While Broken(i) = " "c
            i += 1
        End While
        WordList.Add(New String(" "c, i))

        'If line Commented
        If Broken(i) = "'"c Then
            WordList.Add(Input.Substring(i))
            Return WordList.ToArray
        End If

        'Split
        For index As Integer = i To Broken.Count - 1
            If Separator.Contains(Broken(index)) Then
                Select Case True
                    Case IsIn
                        If Broken(index) = """"c Then
                            IsIn = False
                            TempList.Add(""""c)
                            WordList.Add(New String(TempList.ToArray))
                            TempList.Clear()
                        Else
                            TempList.Add(Broken(index))
                        End If

                    Case Broken(index) = " "c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = "."c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = ")"c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = "("c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = """"c
                        IsIn = True
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        TempList.Add(""""c)

                    Case Broken(index) = ","c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = "'"c
                        WordList.Add(New String(TempList.ToArray))
                        WordList.Add(Input.Substring(index))
                        Return WordList.ToArray

                    Case Broken(index) = "{"c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = "}"c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = "["c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                    Case Broken(index) = "]"c
                        WordList.Add(New String(TempList.ToArray))
                        TempList.Clear()
                        WordList.Add(Broken(index))

                End Select
            Else
                TempList.Add(Broken(index))
            End If
        Next
        If TempList.Count <> 0 Then
            WordList.Add(New String(TempList.ToArray))
        End If
        Return WordList.ToArray
    End Function



#End Region

#Region "WindProc - Refresh"

    Private IsShortRefresh As Boolean = False
    Private LinesToRefresh() As Integer
    Dim Currentline As Integer = 0
    Private Property TopVisibleItem As Integer
    Private Property TotalVisibleItem As Integer
    Private DrawStruct As NativeMethods.DRAWITEMSTRUCT

    Private Sub ShortRefresh(ByVal Ln() As Integer)
        LinesToRefresh = Ln
        IsShortRefresh = True
        Me.Refresh()

    End Sub

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

        Select Case m.Msg

            Case &HF 'WM_PAINT ( call first )
                Currentline = -2
                MyBase.WndProc(m) '<--This returns only after all the 8235 are processed
                IsShortRefresh = False

            Case &H14 'WM_ERASEBKGND (Call second)
                If Not IsShortRefresh Then
                    MyBase.WndProc(m)
                End If

                '========================================================
                '&H202B  =  WM_REFLECT =&H2000 + WM_DRAWITEM=&H2B
                'WM_REFLECT means to handle in the derived class, not from the WIN32 control

            Case &H202B 'then called for each lines
                DrawStruct = DirectCast(m.GetLParam(GetType(NativeMethods.DRAWITEMSTRUCT)), NativeMethods.DRAWITEMSTRUCT)

                'Set the Visible Properties
                If Currentline = -2 Then
                    TotalVisibleItem = (Me.Height \ Me.ItemHeight) - 2
                    TopVisibleItem = CInt(DrawStruct.hDC)
                End If



                'Forward to Windproc just for the line to update
                Currentline += 1
                If Not IsShortRefresh OrElse LinesToRefresh.Contains(Currentline) Then
                    MyBase.WndProc(m)
                Else
                    m.Result = New IntPtr(1)
                End If


            Case Else
                MyBase.WndProc(m)
        End Select
    End Sub

#End Region

#Region " Shadowing"

    ' TODO --- All method "Items"
    <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
    Public Shadows ReadOnly Property Items As ListBox.ObjectCollection
        Get
            Return MyBase.Items
        End Get
    End Property
#End Region


End Class


'
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> NATIVE METHODS <<<<<<<<<<<<<<<<<<<<<<<<<<<
'
'<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> _
Public Class NativeMethods

    Public Structure DRAWITEMSTRUCT
        Public CtlID As Integer
        Public CtlType As Integer
        Public hDC As IntPtr
        Public hwndItem As IntPtr
        Public itemAction As Integer
        Public itemData As IntPtr
        Public itemID As Integer
        Public itemState As Integer
        Public rcItem As Rectangle
    End Structure
    '
    '========================= STRUCTURES FOR CARET API's
    <System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)> _
    Public Structure HWND__
        '''int
        Public unused As Integer
    End Structure

    <System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)> _
    Public Structure HBITMAP__
        '''int
        Public unused As Integer
    End Structure

    <System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)> _
    Public Structure Point
        '''LONG->int
        Public x As Integer
        '''LONG->int
        Public y As Integer
    End Structure

    '========================= CREATE CARET
    '''Return Type: BOOL->int
    '''hWnd: HWND->HWND__*
    '''hBitmap: HBITMAP->HBITMAP__*
    '''nWidth: int
    '''nHeight: int
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="CreateCaret")> _
    Public Shared Function CreateCaret(<System.Runtime.InteropServices.InAttribute()> _
                                       ByVal hWnd As System.IntPtr, _
                                       <System.Runtime.InteropServices.InAttribute()> _
                                       ByVal hBitmap As System.IntPtr, _
                                       ByVal nWidth As Integer, _
                                       ByVal nHeight As Integer) _
                                       As <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
    End Function

    '========================= DESTROY CARET
    '''Return Type: BOOL->int
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="DestroyCaret")> _
    Public Shared Function DestroyCaret() As <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
    End Function

    '=========================== SHOW CARET
    '''Return Type: BOOL->int
    '''hWnd: HWND->HWND__*
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="ShowCaret")> _
    Public Shared Function ShowCaret(<System.Runtime.InteropServices.InAttribute()> _
                                     ByVal hWnd As System.IntPtr) _
                                     As <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
    End Function

    '=========================== HIDE CARET
    '''Return Type: BOOL->int
    '''hWnd: HWND->HWND__*
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="HideCaret")> _
    Public Shared Function HideCaret(<System.Runtime.InteropServices.InAttribute()> _
                                     ByVal hWnd As System.IntPtr) _
                                     As <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
    End Function


    '============================= SET CARET POSITION
    '''Return Type: BOOL->int
    '''X: int
    '''Y: int
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="SetCaretPos")> _
    Public Shared Function SetCaretPos(ByVal X As Integer, ByVal Y As Integer) As <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
    End Function

    '=========================== GET CARET POSITION
    '''Return Type: BOOL->int
    '''lpPoint: LPPOINT->tagPOINT*
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="GetCaretPos")> _
    Public Shared Function GetCaretPos(<System.Runtime.InteropServices.OutAttribute()> _
                                       ByRef lpPoint As Point) _
                                       As <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
    End Function
    '
    '=========================== GET KEY STATE
    '''Return Type: SHORT->short
    '''nVirtKey: int
    <System.Runtime.InteropServices.DllImportAttribute("user32.dll", EntryPoint:="GetKeyState")> _
    Public Shared Function GetKeyState(ByVal nVirtKey As Integer) As Short
    End Function

End Class

